home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
graphic
/
postogrf.zip
/
OPENPRT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-06-06
|
4KB
|
106 lines
{ procedure OpenPrtFile
for use with LIPSogrf/POSTogrf.
Written by Thomas B. Passin in TurboPascal 5.0.
Opens file for output.
v1.2 17 Apr 89. Removed setting Statcode to #0 if ESC was pressed.
Calling program will now figure out what to do.
v1.1 15 Sept 88.
v1.2 17 Feb 89. Added clrEOL to exit when filename = ''. Deleted
reversing colors if in graphics mode. NOTE: this depends on the
using program setting DirectVideo to false.
v1.3 4 Ap 89. Now doesn't ask for comfirmation for output filenames
of con, com1, com2, lpt1, lpt2, prn}
(*{$DEFINE testprt}*)
{$IFDEF testprt}
uses CRT;
{$ENDIF}
{$IFNDEF strings}
{$I strings.src}
{$ENDIF}
Procedure OpenPrtFile(var outfile:text; var name:string80; default:string80;
var statcode:char);
const SP = #32;
var error, t1, t2, i :integer; ans:char; s1:string80;
addon : boolean;
begin {OpenPrtFile}
name := '####';
repeat
GoTOXY(1,wherey);
ReadRaw(s1,'output filename? ', default );
case s1[1] of
CR: Name := default;
SP, ESC: begin GoToXY(1,wherey); clrEOL; Name := ''; end;
else Name := s1;
end; {case}
if Name = ''
then begin
if s1[1] <> ESC then statcode := #0
else statcode := ESC;
clrEOL; exit;
end { exit code for MAIN }
else begin
Assign(outfile, name);
{$I-} Reset(outfile); {$I+}
error := IOResult;
if error <> 0 { couldn't open existing file }
then begin
{$I-} rewrite(outfile); {$I+} (* it's a new file *)
error := IOResult;
If error = 0
then (* opened it *)
else begin
GoToXY(1,wherey);
writeln('couldn''t open file ', name);
clreol;
name := '####';
end
end
else begin { did open existing file }
Close(outfile);
GoToXY(1,wherey); clreol;
s1 := prtfilename;
for i := 1 to length(s1) do
s1[i] := upcase(s1[i]);
if (s1 = 'COM1') or (s1 = 'COM2')
or (s1 = 'LPT1') or (s1 = 'LPT2')
or (s1 = 'PRN')
then ans := 'y'
ELSE begin
GoToXY(1,1); clreol;
write(PrtFileName, ' exists - replace it (y/n)? ');
ans := Readkey; write(ans);
end; {else}
If ans in Yes then ReWrite(outfile)
else begin
name := '####';
end;
end;
end;
until name <> '####';
statcode := CR; { needed for MAIN to decide correct exit }
end;
Procedure ClosePrtFile(var outfile:text; name:string80);
begin
if name = '' then exit else
Close(outfile);
end;
{ -------------------------------------------------------------------
main program fragment for testing
------------------------------------------------------------------- }
(*
const default = 'd:zzz';
var fil:text; name:string80; status:char;
begin
write('open file: ');
OpenPrtfile(fil, name, default, status);
if status = CR then close(fil);
if name <> ESC then writeln('that filename was: ', name);
end.*)